home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / buletq10.zip / BB_LGK10.BAS < prev    next >
BASIC Source File  |  1992-05-31  |  8KB  |  326 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_lgk10.bas 31-May-92 chh
  6. '--test raw speed using 32-bit long integer key, unique
  7. '1) this code uses a non-standard binary field as a sort field
  8. '2) this code is for raw speed tests--it's straight inline
  9. 'C>bc bb_lgk10 /o;
  10. 'C>link bb_lgk10,,nul,bullet;
  11.  
  12. UseDir$ = ".\"                  'all files use this directory except
  13.                                 'the reindex work file which uses the
  14.                                 'SET TMP= directory or the current directory
  15. CLS
  16. PRINT "BB_LGK10.BAS - LONG INT, SIGNED, UNIQUE long int, key access speed test"
  17. PRINT "--uses non-standard data files with binary field values, not DBF"
  18. PRINT ">> USING DIRECTORY "; UseDir$
  19. PRINT
  20.  
  21. TYPE TestRecTYPE
  22. Tag AS STRING * 1
  23. Codenumber AS LONG              'this is the key field (a BINARY type) and
  24. Codename AS STRING * 11         'is not readable by standard dBASE III DBMSs
  25. END TYPE '16                    '--it's used here for speed
  26.                                 'that's it for comments, simple stuff follows
  27. DIM DFP AS DOSFilePack
  28. DIM MP AS MemoryPack
  29. DIM IP AS InitPack
  30. DIM EP AS ExitPack
  31. DIM CDP AS CreateDataPack
  32. DIM CKP AS CreateKeyPack
  33. DIM OP AS OpenPack
  34. DIM AP AS AccessPack
  35.  
  36. DIM FieldList(1 TO 2) AS FieldDescTYPE
  37. DIM TestRec AS TestRecTYPE
  38. DIM ZSTR AS STRING * 1
  39. DIM NameDAT AS STRING * 80
  40. DIM NameIX1 AS STRING * 80
  41. DIM KX1 AS STRING * 136
  42. DIM KeyBuffer AS STRING * 64
  43.  
  44. ZSTR = CHR$(0)
  45. NameDAT = UseDir$ + "BINTEST.DBB" + ZSTR
  46. NameIX1 = UseDir$ + "BINTEST.IX1" + ZSTR
  47.  
  48. FieldList(1).FieldName = "CODENUMBER" + ZSTR
  49. FieldList(1).FieldType = "B"
  50. FieldList(1).FieldLength = CHR$(4)
  51. FieldList(1).FieldDC = CHR$(0)
  52. FieldList(2).FieldName = "CODENAME" + ZSTR + ZSTR
  53. FieldList(2).FieldType = "C"
  54. FieldList(2).FieldLength = CHR$(11)
  55. FieldList(2).FieldDC = CHR$(0)
  56.  
  57. level = 100
  58. MP.Func = MemoryXB
  59. stat = BULLET(MP)
  60. IF MP.Memory < 140000 THEN
  61.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  62.     MP.Func = MemoryXB
  63.     stat = BULLET(MP)
  64.     IF MP.Memory < 140000 THEN stat = 8 : GOTO Abend
  65. END IF
  66.  
  67. level = 110
  68. IP.Func = InitXB
  69. IP.JFTmode = 0
  70. stat = BULLET(IP)
  71. IF stat THEN GOTO Abend
  72.  
  73. level = 120
  74. EP.Func = AtExitXB
  75. stat = BULLET(EP)
  76.  
  77. level = 130
  78. DFP.Func = DeleteFileDOS
  79. DFP.FilenamePtrOff = VARPTR(NameDAT)
  80. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  81. stat = BULLET(DFP)
  82. DFP.FilenamePtrOff = VARPTR(NameIX1)
  83. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  84. stat = BULLET(DFP)
  85.  
  86. level = 1000
  87. CDP.Func = CreateDXB
  88. CDP.FilenamePtrOff = VARPTR(NameDAT)
  89. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  90. CDP.NoFields = 2
  91. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  92. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  93. CDP.FileID = &HFF  '<<== NON-standard DBF file ID
  94. stat = BULLET(CDP)
  95. IF stat THEN GOTO Abend
  96.  
  97. level = 1010
  98. OP.Func = OpenDXB
  99. OP.FilenamePtrOff = VARPTR(NameDAT)
  100. OP.FilenamePtrSeg = VARSEG(NameDAT)
  101. OP.ASmode = ReadWrite + DenyNone
  102. stat = BULLET(OP)
  103. IF stat THEN GOTO Abend
  104. HandDAT = OP.Handle
  105.  
  106. level = 1100
  107. KX1 = "CODENUMBER" + ZSTR
  108. CKP.Func = CreateKXB
  109. CKP.FilenamePtrOff = VARPTR(NameIX1)
  110. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  111. CKP.KeyExpPtrOff = VARPTR(KX1)
  112. CKP.KeyExpPtrSeg = VARSEG(KX1)
  113. CKP.XBlink = HandDAT
  114. CKP.KeyFlags = cLONG + cSIGNED + cUNIQUE
  115. CKP.CodePageID = -1
  116. CKP.CountryCode = -1
  117. CKP.CollatePtrOff = 0
  118. CKP.CollatePtrSeg = 0
  119. stat = BULLET(CKP)
  120. IF stat THEN GOTO Abend
  121.  
  122. level = 1110
  123. OP.Func = OpenKXB
  124. OP.FilenamePtrOff = VARPTR(NameIX1)
  125. OP.FilenamePtrSeg = VARSEG(NameIX1)
  126. OP.ASmode = ReadWrite + DenyNone
  127. OP.xbHandle = HandDAT
  128. stat = BULLET(OP)
  129. IF stat THEN GOTO Abend
  130. HandIX1 = OP.Handle
  131.  
  132. AP.Func = AddRecordXB
  133. AP.Handle = HandDAT
  134. AP.RecPtrOff = VARPTR(TestRec)
  135. AP.RecPtrSeg = VARSEG(TestRec)
  136. AP.KeyPtrOff = VARPTR(KeyBuffer)
  137. AP.KeyPtrSeg = VARSEG(KeyBuffer)
  138. AP.NextPtrOff = 0
  139. AP.NextPtrSeg = 0
  140. TestRec.Tag = " "
  141. TestRec.Codename = "xxxSAMExxxx"
  142. INPUT "Recs to add/reindex:"; Recs2Add&
  143.  
  144. level = 1200
  145. low& = -3
  146. high& = low& + Recs2Add& - 1
  147. PRINT "Adding"; Recs2Add&; "records ( keys "; low&; "to"; high&; ")...";
  148. GOSUB StartTimer
  149. FOR recs& = low& TO high&
  150.    TestRec.Codenumber = recs&
  151.    stat = BULLET(AP)
  152.    IF stat THEN GOTO Abend
  153. NEXT
  154. GOSUB EndTimer
  155. PRINT secs&; "secs."
  156.  
  157. level = 1210
  158. PRINT "Reindexing...";
  159. AP.Func = ReindexXB
  160. AP.Handle = HandIX1
  161. GOSUB StartTimer
  162. sidx = BULLET(AP)
  163. stat = AP.stat
  164. IF stat THEN GOTO Abend
  165. GOSUB EndTimer
  166. PRINT secs&; "secs."
  167. PRINT
  168.  
  169. level = 1300
  170. PRINT "Accessing all keys in forward order...";
  171. cnt& = 0&
  172. GOSUB StartTimer
  173. AP.Func = FirstKeyXB
  174. stat = BULLET(AP)
  175. DO UNTIL stat
  176.    cnt& = cnt& + 1
  177.    AP.Func = NextKeyXB
  178.    stat = BULLET(AP)
  179. LOOP
  180. IF stat = 202 THEN stat = 0
  181. IF stat THEN GOTO Abend
  182. GOSUB EndTimer
  183. PRINT secs&; "secs for"; cnt&; "keys"
  184.  
  185. level = 1310
  186. PRINT "Accessing all keys in reverse order...";
  187. cnt& = 0&
  188. GOSUB StartTimer
  189. AP.Func = LastKeyXB
  190. stat = BULLET(AP)
  191. DO UNTIL stat
  192.    cnt& = cnt& + 1
  193.    AP.Func = PrevKeyXB
  194.    stat = BULLET(AP)
  195. LOOP
  196. IF stat = 203 THEN stat = 0
  197. IF stat THEN GOTO Abend
  198. GOSUB EndTimer
  199. PRINT secs&; "secs for"; cnt&; "keys"
  200.  
  201. PRINT
  202. level = 1400
  203. PRINT "Accessing all keys+records in forward order...";
  204. cnt& = 0&
  205. GOSUB StartTimer
  206. AP.Func = GetFirstXB
  207. stat = BULLET(AP)
  208. DO UNTIL stat
  209.    cnt& = cnt& + 1
  210.    AP.Func = GetNextXB
  211.    stat = BULLET(AP)
  212. LOOP
  213. IF stat = 202 THEN stat = 0
  214. IF stat THEN GOTO Abend
  215. GOSUB EndTimer
  216. PRINT secs&; "secs for"; cnt&
  217.  
  218. level = 1410
  219. PRINT "Accessing all keys+records in reverse order...";
  220. cnt& = 0&
  221. GOSUB StartTimer
  222. AP.Func = GetLastXB
  223. stat = BULLET(AP)
  224. DO UNTIL stat
  225.    cnt& = cnt& + 1
  226.    AP.Func = GetPrevXB
  227.    stat = BULLET(AP)
  228. LOOP
  229. IF stat = 203 THEN stat = 0
  230. IF stat THEN GOTO Abend
  231. GOSUB EndTimer
  232. PRINT secs&; "secs for"; cnt&
  233.  
  234. PRINT "Okay."
  235. EndIt:
  236. EP.Func = ExitXB
  237. stat = BULLET(EP)
  238. END
  239.  
  240.  
  241. Abend:
  242. PRINT
  243. PRINT "Error:"; stat; "at level"; level; "while performing ";
  244. SELECT CASE level
  245. CASE IS = 999
  246.    SELECT CASE level
  247.    CASE 100
  248.       PRINT "a memory request of 150K."
  249.    CASE 110
  250.       PRINT "BULLET initialization."
  251.    CASE 120
  252.       PRINT "registering of ExitXB with _atexit."
  253.    CASE ELSE
  254.       PRINT "Preliminaries unknown."
  255.    END SELECT
  256. CASE IS <= 1099
  257.    SELECT CASE level
  258.    CASE 1000
  259.       PRINT "data file create."
  260.    CASE 1010
  261.       PRINT "data file open."
  262.    CASE ELSE
  263.       PRINT "data file unknown."
  264.    END SELECT
  265. CASE IS <= 1199
  266.    SELECT CASE level
  267.    CASE 1000
  268.       PRINT "index file create."
  269.    CASE 1010
  270.       PRINT "index file open."
  271.    CASE ELSE
  272.       PRINT "index file unknown."
  273.    END SELECT
  274. CASE IS <= 1299
  275.    SELECT CASE level
  276.    CASE 1200
  277.       PRINT "adding records."
  278.    CASE 1210
  279.       PRINT "reindexing."
  280.    CASE ELSE
  281.       PRINT "adding unknown."
  282.    END SELECT
  283. CASE IS <= 1399
  284.    SELECT CASE level
  285.    CASE 1300
  286.       PRINT "First/NextKey."
  287.    CASE 1310
  288.       PRINT "Last/PrevKey."
  289.    CASE ELSE
  290.       PRINT "Key/unknown."
  291.    END SELECT
  292. CASE IS <= 1499
  293.    SELECT CASE level
  294.    CASE 1400
  295.       PRINT "GetFirst/Next."
  296.    CASE 1410
  297.       PRINT "GetLast/Prev."
  298.    CASE ELSE
  299.       PRINT "Get/unknown."
  300.    END SELECT
  301. CASE ELSE
  302.    PRINT "unknown."
  303. END SELECT
  304. GOTO EndIt
  305.  
  306. '----------
  307. StartTimer:
  308. DEF SEG = &H40
  309. lb1 = PEEK(&H6C)
  310. hb1 = PEEK(&H6D)
  311. lb2 = PEEK(&H6E)
  312. DEF SEG
  313. stime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  314. RETURN
  315.  
  316. EndTimer:
  317. DEF SEG = &H40
  318. lb1 = PEEK(&H6C)
  319. hb1 = PEEK(&H6D)
  320. lb2 = PEEK(&H6E)
  321. DEF SEG
  322. etime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  323. secs& = ((etime& - stime&) * 10) \ 182
  324. RETURN
  325.  
  326.